Prática Avançada de Data Science e Visualization

Insper 2022-33

Sobre mim

Meu nome é Julio. Eu gosto de MasterChef

Sobre mim

Eu não gosto de

  • Captchas
  • tretas R vs python

Meu papel

Meu papel nessa disciplina será ajudar no aprendizado da parte técnica – códigos etc.

  • Também posso dar pitacos nas apresentações e salvá-los em situações de desespero (atendimentos extras).

Lab 01

Nesse lab, nosso objetivo será construir soluções em R e python para problemas comuns de transformação de dados.

  • Equipes de 3 pessoas. Começaremos com uma alocação por afinidade. Dependendo dos resultados, realocamos.

  • Eu serei o Google. Na parte do R, verificarei se vocês fizeram tudo certo. Na parte do python, vocês vão me ensinar.

  • No final de cada exercício, discutiremos aspectos teóricos sobre as ferramentas (se necessário).

Prêmios

  • As melhores resoluções receberão stickers. A quantidade de stickers depende da dificuldade do exercício.

Vamos lá!

Exercício 1 (transformação) 🛑

pinguins
# A tibble: 344 × 8
   especie           ilha      comprimento…¹ profu…² compr…³ massa…⁴ sexo    ano
   <fct>             <fct>             <dbl>   <dbl>   <int>   <int> <fct> <int>
 1 Pinguim-de-adélia Torgersen          39.1    18.7     181    3750 macho  2007
 2 Pinguim-de-adélia Torgersen          39.5    17.4     186    3800 fêmea  2007
 3 Pinguim-de-adélia Torgersen          40.3    18       195    3250 fêmea  2007
 4 Pinguim-de-adélia Torgersen          NA      NA        NA      NA <NA>   2007
 5 Pinguim-de-adélia Torgersen          36.7    19.3     193    3450 fêmea  2007
 6 Pinguim-de-adélia Torgersen          39.3    20.6     190    3650 macho  2007
 7 Pinguim-de-adélia Torgersen          38.9    17.8     181    3625 fêmea  2007
 8 Pinguim-de-adélia Torgersen          39.2    19.6     195    4675 macho  2007
 9 Pinguim-de-adélia Torgersen          34.1    18.1     193    3475 <NA>   2007
10 Pinguim-de-adélia Torgersen          42      20.2     190    4250 <NA>   2007
# … with 334 more rows, and abbreviated variable names ¹​comprimento_bico,
#   ²​profundidade_bico, ³​comprimento_nadadeira, ⁴​massa_corporal
# ℹ Use `print(n = ...)` to see more rows
  • Selecionar especie, ilha, comprimento do bico
  • Filtrar valores vazios
  • Agrupar por espécie
  • Calcular média e mediana
  • Calcular a diferença absoluta da média e mediana
# A tibble: 3 × 4
  especie             media mediana diferenca
  <fct>               <dbl>   <dbl>     <dbl>
1 Pinguim-de-barbicha  48.8    49.6   0.716  
2 Pinguim-gentoo       47.5    47.3   0.205  
3 Pinguim-de-adélia    38.8    38.8   0.00861

Exercício 2 (pivotagem) 🛑🛑

# A tibble: 7,240 × 60
   pais        iso2  iso3    ano novos…¹ novos…² novos…³ novos…⁴ novos…⁵ novos…⁶
   <chr>       <chr> <chr> <int>   <int>   <int>   <int>   <int>   <int>   <int>
 1 Afeganistão AF    AFG    1980      NA      NA      NA      NA      NA      NA
 2 Afeganistão AF    AFG    1981      NA      NA      NA      NA      NA      NA
 3 Afeganistão AF    AFG    1982      NA      NA      NA      NA      NA      NA
 4 Afeganistão AF    AFG    1983      NA      NA      NA      NA      NA      NA
 5 Afeganistão AF    AFG    1984      NA      NA      NA      NA      NA      NA
 6 Afeganistão AF    AFG    1985      NA      NA      NA      NA      NA      NA
 7 Afeganistão AF    AFG    1986      NA      NA      NA      NA      NA      NA
 8 Afeganistão AF    AFG    1987      NA      NA      NA      NA      NA      NA
 9 Afeganistão AF    AFG    1988      NA      NA      NA      NA      NA      NA
10 Afeganistão AF    AFG    1989      NA      NA      NA      NA      NA      NA
# … with 7,230 more rows, 50 more variables: novos_fpp_h65 <int>,
#   novos_fpp_m014 <int>, novos_fpp_m1524 <int>, novos_fpp_m2534 <int>,
#   novos_fpp_m3544 <int>, novos_fpp_m4554 <int>, novos_fpp_m5564 <int>,
#   novos_fpp_m65 <int>, novos_fpn_h014 <int>, novos_fpn_h1524 <int>,
#   novos_fpn_h2534 <int>, novos_fpn_h3544 <int>, novos_fpn_h4554 <int>,
#   novos_fpn_h5564 <int>, novos_fpn_h65 <int>, novos_fpn_m014 <int>,
#   novos_fpn_m1524 <int>, novos_fpn_m2534 <int>, novos_fpn_m3544 <int>, …
# ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names
  • empilhar as colunas “novos_fpp”, jogando as outras “novos_*” fora
  • filtrar ano maior ou igual a 2008 e países do resultado
  • agrupar por país e ano
  • somar a quantidade total de casos
  • jogar a coluna ano nas colunas
# A tibble: 3 × 6
  pais           `2008` `2009` `2010` `2011` `2012`
  <chr>           <int>  <int>  <int>  <int>  <int>
1 Brasil          37697  39212  37874  40253  40108
2 Índia          615492 624617 630164 642311 629589
3 Estados Unidos   4742   4010   3526   3686   3562
             pais    2008    2009    2010    2011    2012
0          Brasil   37697   39212   37874   40253   40108
1           Índia  615492  624617  630164  642311  629589
2  Estados Unidos    4742    4010    3526    3686    3562

Exercício 3 (joins) 🛑🛑🛑🛑

print(clima, n = 1)
# A tibble: 26,115 × 15
  origem   ano   mes   dia  hora tempe…¹ ponto…² umidade direc…³ veloc…⁴ veloc…⁵
  <chr>  <int> <int> <int> <int>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
1 EWR     2013     1     1     1    39.0    26.1    59.4     270    10.4      NA
# … with 26,114 more rows, 4 more variables: precipitacao <dbl>, pressao <dbl>,
#   visibilidade <dbl>, data_hora <dttm>, and abbreviated variable names
#   ¹​temperatura, ²​ponto_condensacao, ³​direcao_vento, ⁴​velocidade_vento,
#   ⁵​velocidade_rajada
# ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names
print(aeroportos, n = 1)
# A tibble: 1,458 × 8
  codigo_aeroporto nome           latit…¹ longi…² altura fuso_…³ horar…⁴ fuso_…⁵
  <chr>            <chr>            <dbl>   <dbl>  <dbl>   <dbl> <chr>   <chr>  
1 04G              Lansdowne Air…    41.1   -80.6   1044      -5 A       Americ…
# … with 1,457 more rows, and abbreviated variable names ¹​latitude, ²​longitude,
#   ³​fuso_horario, ⁴​horario_verao, ⁵​fuso_horario_iana
# ℹ Use `print(n = ...)` to see more rows
print(companhias_aereas, n = 1)
# A tibble: 16 × 2
  companhia_aerea nome             
  <chr>           <chr>            
1 9E              Endeavor Air Inc.
# … with 15 more rows
# ℹ Use `print(n = ...)` to see more rows
print(avioes, n = 1)
# A tibble: 3,322 × 9
  codigo_cauda   ano tipo         fabri…¹ modelo motores assen…² veloc…³ tipo_…⁴
  <chr>        <int> <chr>        <chr>   <chr>    <int>   <int>   <int> <chr>  
1 N10156        2004 Ala fixa mu… EMBRAER EMB-1…       2      55      NA Turbo …
# … with 3,321 more rows, and abbreviated variable names ¹​fabricante,
#   ²​assentos, ³​velocidade, ⁴​tipo_motor
# ℹ Use `print(n = ...)` to see more rows
print(voos, n = 1)
# A tibble: 336,776 × 19
    ano   mes   dia horario_sa…¹ saida…² atras…³ horar…⁴ chega…⁵ atras…⁶ compa…⁷
  <int> <int> <int>        <int>   <int>   <dbl>   <int>   <int>   <dbl> <chr>  
1  2013     1     1          517     515       2     830     819      11 UA     
# … with 336,775 more rows, 9 more variables: voo <int>, cauda <chr>,
#   origem <chr>, destino <chr>, tempo_voo <dbl>, distancia <dbl>, hora <dbl>,
#   minuto <dbl>, data_hora <dttm>, and abbreviated variable names
#   ¹​horario_saida, ²​saida_programada, ³​atraso_saida, ⁴​horario_chegada,
#   ⁵​chegada_prevista, ⁶​atraso_chegada, ⁷​companhia_aerea
# ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names
  • juntar voos, clima, companhias aéreas e aviões
  • retirar fabricante vazio e retirar origem “EWR”
  • agrupar por fabricante, nome e origem
  • obter quantidade de vôos e temperatura média
  • ordenar pela quantidade
  • mostrar resultados com > 5 mil observações
# A tibble: 10 × 5
   fabricante                    nome                     origem     n tempera…¹
   <chr>                         <chr>                    <chr>  <int>     <dbl>
 1 AIRBUS                        JetBlue Airways          JFK    21003      54.8
 2 EMBRAER                       JetBlue Airways          JFK    16785      57.9
 3 BOEING                        Delta Air Lines Inc.     JFK    15474      57.2
 4 BOMBARDIER INC                Endeavor Air Inc.        JFK    13844      55.6
 5 AIRBUS INDUSTRIE              Delta Air Lines Inc.     LGA     8233      55.2
 6 BOMBARDIER INC                ExpressJet Airlines Inc. LGA     7573      60.5
 7 MCDONNELL DOUGLAS AIRCRAFT CO Delta Air Lines Inc.     LGA     6845      59.3
 8 AIRBUS INDUSTRIE              US Airways Inc.          LGA     6280      57.1
 9 BOEING                        Southwest Airlines Co.   LGA     6072      57.3
10 BOEING                        American Airlines Inc.   JFK     5146      56.3
# … with abbreviated variable name ¹​temperatura_media
                      fabricante                      nome origem      n  \
0                         AIRBUS           JetBlue Airways    JFK  21003   
1                        EMBRAER           JetBlue Airways    JFK  16785   
2                         BOEING      Delta Air Lines Inc.    JFK  15474   
3                 BOMBARDIER INC         Endeavor Air Inc.    JFK  13844   
4               AIRBUS INDUSTRIE      Delta Air Lines Inc.    LGA   8233   
5                 BOMBARDIER INC  ExpressJet Airlines Inc.    LGA   7573   
6  MCDONNELL DOUGLAS AIRCRAFT CO      Delta Air Lines Inc.    LGA   6845   
7               AIRBUS INDUSTRIE           US Airways Inc.    LGA   6280   
8                         BOEING    Southwest Airlines Co.    LGA   6072   
9                         BOEING    American Airlines Inc.    JFK   5146   

   temperatura_media  
0          54.811566  
1          57.870006  
2          57.198679  
3          55.559239  
4          55.164580  
5          60.480547  
6          59.313049  
7          57.140805  
8          57.276017  
9          56.301159  

Exercício 4 (feat eng) 🛑🛑🛑🛑🛑

  • Melhorar o poder preditivo do modelo sem mudar nada na parte da modelagem
  • Vamos mexer apenas nas preditoras
voos_select <- voos |> 
  select(
    ano, mes, dia, hora,
    companhia_aerea, cauda,
    origem, destino,
    y = atraso_saida
  ) |> 
  drop_na(y)

voos_select
# A tibble: 328,521 × 9
     ano   mes   dia  hora companhia_aerea cauda  origem destino     y
   <int> <int> <int> <dbl> <chr>           <chr>  <chr>  <chr>   <dbl>
 1  2013     1     1     5 UA              N14228 EWR    IAH         2
 2  2013     1     1     5 UA              N24211 LGA    IAH         4
 3  2013     1     1     5 AA              N619AA JFK    MIA         2
 4  2013     1     1     5 B6              N804JB JFK    BQN        -1
 5  2013     1     1     6 DL              N668DN LGA    ATL        -6
 6  2013     1     1     5 UA              N39463 EWR    ORD        -4
 7  2013     1     1     6 B6              N516JB EWR    FLL        -5
 8  2013     1     1     6 EV              N829AS LGA    IAD        -3
 9  2013     1     1     6 B6              N593JB JFK    MCO        -3
10  2013     1     1     6 AA              N3ALAA LGA    ORD        -2
# … with 328,511 more rows
# ℹ Use `print(n = ...)` to see more rows
set.seed(1)
split <- rsample::initial_split(voos_select, prop = .8)
treino <- rsample::training(split)
teste <- rsample::testing(split)

feat_eng <- function(dados) {
  # ...exercicio...
  dados |> 
    select(-cauda)
}

treino_eng <- feat_eng(treino)
teste_eng <- feat_eng(teste) # cuidado

modelo <- parsnip::rand_forest("regression", trees = 20) |>  
  parsnip::set_engine("ranger")
fitted <- parsnip::fit(modelo, y ~ ., data = treino_eng)
preds <- predict(fitted, new_data = teste_eng)
result_antes <- yardstick::rmse_vec(teste_eng$y, preds$.pred)

Resultado antes:

[1] 36.98851

Resultado depois:

[1] 35.95097

Lab 02 - ggplot2

Lab 02

Nesse lab, nosso objetivo será construir soluções em ggplot2 para gráficos estatísticos.

  • Os grupos são os que montamos para o trabalho final.

  • As tarefas serão imitar um gráfico que eu montei para vocês usando ggplot2. Eu mostrarei apenas a imagem. Posso dar dicas no meio do caminho.

  • O grupo que conseguir fazer o gráfico primeiro ganhará prêmios.

  • Quem fizer versões em python dos gráficos para me ensinar ganhará prêmios.

Base olist

Utilizaremos a base de dados da olist, para que vocês possam aproveitar os trabalhos nas atividades integradoras.

  • Teoricamente, vocês já têm uma base de dados arrumada em mãos, por conta dos exercícios do curso de Design.

  • Para garantir que as visualizações funcionam, no entanto, disponibilizei uma base que eu montei (pode conter erros) no material dos labs.

  • A base está tanto em .parquet (usar pacote {arrow} quanto em .rds. Use a que for mais confortável.

  • Se quiser usar sua própria base, sem problemas!

Exercício 01 🍪

  • Usar a coluna types

  • Estudar a função theme()

  • As geom_label() ficam na metade da altura da barra.

#' Author:
#' Subject:


# Import -----------------------------------------------------------------------
# readr::write_rds(d, "")

library(ggplot2)


# grafico 1 ---------------------------------------------------------------


items |> 
  dplyr::count(types) |> 
  dplyr::mutate(types = forcats::fct_reorder(types, n)) |> 
  dplyr::filter(n > 100) |> 
  dplyr::mutate(n = n/1000) |> 
  ggplot(aes(x = n, y = types)) +
  geom_col(fill = "#8ae3d7", width = .5) +
  geom_label(aes(label = round(n, 2), x = n/2)) +
  theme_dark(16) +
  labs(
    x = "Quantidade\n(milhares)",
    y = "Forma de pagamento",
    title = "Formas de pagamento mais comuns",
    subtitle = "Considerando tipos com mais de 100 observações",
    caption = "Fonte: Olist"
  ) +
  theme(
    panel.background = element_rect(fill = "gray20"),
    plot.background = element_rect(fill = "gray10"),
    text = element_text(family = "serif", colour = "white"),
    axis.text = element_text(family = "serif", colour = "white"),
    panel.grid.minor = element_blank()
  )


# grafico 2 ---------------------------------------------------------------

items |> 
  dplyr::mutate(
    data = as.Date(order_purchase_timestamp),
    data = lubridate::floor_date(data, "month"),
    estado = forcats::fct_other(
      seller_state, 
      keep = c("SP", "RJ"), 
      other_level = "Outros"
    )
  ) |>
  dplyr::filter(
    data >= "2017-01-01",
    data <= "2018-07-01"
  ) |> 
  dplyr::count(data, estado) |> 
  ggplot() +
  aes(x = data, y = n, colour = estado) +
  geom_line(size = 2) +
  scale_color_viridis_d(begin = .2, end = .8) +
  labs(
    x = "Data", 
    y = "Quantidade", 
    title = "São Paulo tem mais vendas",
    subtitle = "O que é esperado, pois a população é maior 😬",
    caption = "Fonte: Olist",
    color = "Estado"
  ) +
  scale_x_date(
    date_breaks = "3 month", 
    date_labels = "%b\n%Y"
  ) +
  theme_light(15) +
  theme(
    legend.position = "bottom"
  )
  

# grafico 04 --------------------------------------------------------------

estados <- geobr::read_state()

set.seed(42)
items |> 
  dplyr::count(
    seller_state,
    geolocation_lat_seller,
    geolocation_lng_seller,
    geolocation_lat_customer,
    geolocation_lng_customer
  ) |> 
  dplyr::filter(seller_state %in% c("SP", "MG", "RJ")) |> 
  dplyr::slice_sample(n = 1000) |> 
  ggplot() +
  geom_sf(data = estados, fill = "gray95", size = .1) +
  geom_curve(
    mapping = aes(
      x = geolocation_lng_seller,
      y = geolocation_lat_seller,
      xend = geolocation_lng_customer,
      yend = geolocation_lat_customer
    ), 
    arrow = arrow(length = unit(0.1, "inches")),
    curvature = .2,
    alpha = .2,
    colour = "royalblue"
  ) +
  facet_wrap(~seller_state, strip.position = "bottom") +
  theme_void(base_size = 16) +
  labs(
    title = "Para onde vão as compras?",
    subtitle = "Comparando São Paulo, Minas Gerais e Rio de Janeiro",
    caption = "Fonte: Olist"
  ) 

Exercício 02 🍪🍪

  • Usar scale_x_date()

  • Estudar scale_color_viridis_d()

  • lubridate::floor_date() para aproximar datas

  • case_when() ou fct_other() para reclassificar uma variável categórica

  • filtrar a base para o intervalo de datas entre “2017-01-01” e “2018-07-01”

  • devemos contar/agrupar por data (mês) e estado

items |> 
  dplyr::mutate(
    data = as.Date(order_purchase_timestamp),
    data = lubridate::floor_date(data, "month"),
    estado = forcats::fct_other(
      seller_state, 
      keep = c("SP", "RJ"), 
      other_level = "Outros"
    )
  ) |>
  dplyr::filter(
    data >= "2017-01-01",
    data <= "2018-07-01"
  ) |> 
  dplyr::count(data, estado) |> 
  ggplot() +
  aes(x = data, y = n, colour = estado) +
  geom_line(size = 2) +
  scale_color_viridis_d(begin = .2, end = .8) +
  labs(
    x = "Data", 
    y = "Quantidade", 
    title = "São Paulo tem mais vendas",
    subtitle = "O que é esperado, pois a população é maior 😬",
    caption = "Fonte: Olist",
    color = "Estado"
  ) +
  scale_x_date(
    date_breaks = "3 month", 
    date_labels = "%b\n%Y"
  ) +
  theme_light(15) +
  theme(
    legend.position = "bottom"
  )

Exercício 03 🍪🍪🍪

  • Usar o pacote {ggridges}.

  • Para pintar apenas uma categoria, crie uma coluna.

  • Para anotações no gráfico (como “Mediana”), use a função annotate().

  • Para fazer os reais, use a função scales::scales_dollar_format().

items_agg <- items |> 
  group_by(product_category_name) |> 
  filter(n() > 4000) |> 
  ungroup() |> 
  mutate(
    product_category_name = fct_reorder(
      product_category_name, price, median
    ),
    relogios = ifelse(
      product_category_name == "relogios_presentes",
      "destacar", "não destacar"
    )
  )

mediana <- items_agg |> 
  summarise(mediana = median(price))

items_agg |> 
  ggplot() +
  aes(x = price, y = product_category_name, fill = relogios) +
  ggridges::geom_density_ridges(
    quantile_lines = TRUE,
    quantiles = 2,
    na.rm = FALSE,
    n = 2048, 
    show.legend = FALSE
  ) +
  scale_x_continuous(
    limits = c(0, NA),
    labels = scales::dollar_format(prefix = "R$")
  ) +
  coord_cartesian(xlim = c(0, 300)) +
  geom_vline(
    aes(xintercept = mediana), 
    data = mediana,
    linetype = 2,
    colour = "red"
  ) + 
  scale_fill_manual(
    values = c("#6686e6", "#eaeaea")
  ) +
  theme_minimal()

Exercício 04 🍪🍪🍪🍪

  • Faça uma amostra de 1000 observações dos dados, com set.seed(42)

  • Para obter o mapa, usar o pacote {geobr}

  • Para plotar o mapa, usar a função geom_sf()

  • Estamos desenhando CURVAS

  • Use facets

estados <- geobr::read_state()

set.seed(42)
items |> 
  dplyr::count(
    seller_state,
    geolocation_lat_seller,
    geolocation_lng_seller,
    geolocation_lat_customer,
    geolocation_lng_customer
  ) |> 
  dplyr::filter(seller_state %in% c("SP", "MG", "RJ")) |> 
  dplyr::slice_sample(n = 1000) |> 
  ggplot() +
  geom_sf(data = estados, fill = "gray95", size = .1) +
  geom_curve(
    mapping = aes(
      x = geolocation_lng_seller,
      y = geolocation_lat_seller,
      xend = geolocation_lng_customer,
      yend = geolocation_lat_customer
    ), 
    arrow = arrow(length = unit(0.1, "inches")),
    curvature = .2,
    alpha = .2,
    colour = "royalblue"
  ) +
  facet_wrap(~seller_state, strip.position = "bottom") +
  theme_void(base_size = 16) +
  labs(
    title = "Para onde vão as compras?",
    subtitle = "Comparando São Paulo, Minas Gerais e Rio de Janeiro",
    caption = "Fonte: Olist"
  )